home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMM / TPASYNC / TPASYNC.PAS < prev   
Pascal/Delphi Source File  |  1990-01-23  |  11KB  |  340 lines
  1. (*****************************************************************************
  2.  
  3.   Turbo PASCAL Async Manager        version 2.01
  4.  
  5.   Copyright 1986-1990 by Kaleb Axon. All Rights Reserved.
  6.  
  7.  
  8.   For use with Turbo PASCAL 4.0
  9.                             5.0
  10.                             5.5
  11.  
  12.   (Originally written in Turbo PASCAL 3.01)
  13.  
  14.   The only requirement for freely incorporating this code into your own
  15.   programs is that the author of this code be given due credit wherever is
  16.   most appropriate (program's opening screen, copyright page or introduction
  17.   of manual, etc).
  18.  
  19.   Information on updates and new releases to add to your library of Turbo
  20.   PASCAL source will be released from time to time via the PASCAL net-mail
  21.   echo, or you may drop me a note with your name and address (sent to the
  22.   address below).
  23.  
  24.   If you have any questions or comments, please direct them to:
  25.  
  26.         Kaleb Axon
  27.         1841 W. Katella St.
  28.         Springfield, MO 65807
  29.  
  30. *****************************************************************************)
  31.  
  32. { update history:                                                            }
  33. {                                                                            }
  34. { date      programmer       description of changes                          }
  35. { --------  ---------------  ----------------------------------------------- }
  36. { 07/15/86  Kaleb Axon       Initial writing                                 }
  37. { 05/18/88  Kaleb Axon       Now supports two ports simultaneously (1.10)    }
  38. { 10/02/88  Kaleb Axon       Converted to Turbo PASCAL 4.0 (2.00)            }
  39. { 01/23/90  Kaleb Axon       Increased maximum baud rate to 56000 bps (2.01) }
  40.  
  41. unit TPAsync;
  42. interface
  43.   uses
  44.     Dos;
  45.   procedure AsyncCloseKeepDTR(Handle  : byte);
  46.   function Carrier(Handle  : byte) : boolean;
  47.   procedure AsyncSendString(Handle  : byte;
  48.                             S       : string);
  49.   procedure AsyncSend(Handle  : byte;
  50.                       Ch      : char);
  51.   function AsyncBufferCheck(Handle  : byte) : boolean;
  52.   function AsyncBufferRead(Handle  : byte;
  53.                            var C   : char) : boolean;
  54.   function AsyncOpen(Handle        : byte;
  55.                      ComPort       : integer;
  56.                      BaudRate      : word;
  57.                      Parity        : char;
  58.                      DataBits      : integer;
  59.                      StopBits      : integer) : boolean;
  60.   procedure AsyncClose(Handle  : byte);
  61.   procedure AsyncChange(Handle        : byte;
  62.                         BaudRate      : word;
  63.                         Parity        : char;
  64.                         DataBits      : integer;
  65.                         StopBits      : integer);
  66. implementation
  67.  
  68. const
  69.   UART      : record
  70.                 THR,RBR,IER,IIR,LCR,MCR,LSR,MSR : byte;
  71.               end =
  72.                 (THR:$00;RBR:$00;IER:$01;IIR:$02;LCR:$03;MCR:$04;LSR:$05;
  73.                  MSR:$06);
  74.   I8088     : record
  75.                 IMR : byte;
  76.               end =
  77.                 (IMR:$21);
  78. type
  79.   AsyncBufferPointer = ^AsyncBufferType;
  80.   AsyncBufferType    = array[0..4095] of char;
  81. var
  82.   AsyncV : array[1..2] of record
  83.              HeapTop        : ^integer;
  84.              Buffer         : AsyncBufferPointer;
  85.              BufferHead     : integer;
  86.              BufferTail     : integer;
  87.              OpenFlag       : boolean;
  88.              Port           : byte;
  89.              Base           : integer;
  90.              IRQ            : integer;
  91.              BufferOverflow : boolean;
  92.              AsyncChar      : char;
  93.            end;
  94.   AsyncBIOSPortTable : array[1..2] of integer absolute $0040:0000;
  95.  
  96. procedure AsyncChange(Handle        : byte;
  97.                       BaudRate      : word;
  98.                       Parity        : char;
  99.                       DataBits      : integer;
  100.                       StopBits      : integer);
  101. const
  102.   DivisorTable : array [1..10] of record
  103.                                    Baud    : word;
  104.                                    Divisor : integer;
  105.                                  end =
  106.                   ((Baud:300; Divisor:384),
  107.                    (Baud:450; Divisor:256),
  108.                    (Baud:600; Divisor:192),
  109.                    (Baud:1200; Divisor:96),
  110.                    (Baud:2400; Divisor:48),
  111.                    (Baud:4800; Divisor:24),
  112.                    (Baud:9600; Divisor:12),
  113.                    (Baud:19200; Divisor:6),
  114.                    (Baud:38400; Divisor:3),
  115.                    (Baud:56000; Divisor:2));
  116. var
  117.   I   : integer;
  118.   DV  : integer;
  119.   LCR : integer;
  120. begin
  121.   I := 0;
  122.   repeat
  123.     I := I+1;
  124.   until (DivisorTable[I].Baud = BaudRate) or (I > 10);
  125.   if I > 10 then
  126.     I := 1;
  127.   DV := DivisorTable[I].Divisor;
  128.   Parity := Upcase(Parity);
  129.   LCR := 0;
  130.   case Parity of
  131.     'E' : LCR := LCR or $18;
  132.     'O' : LCR := LCR or $08;
  133.     'N' : LCR := LCR or $00;
  134.     'M' : LCR := LCR or $28;
  135.     'S' : LCR := LCR or $38;
  136.   else
  137.     LCR := LCR or $00;
  138.   end;
  139.   case DataBits of
  140.     5 : LCR := LCR or $00;
  141.     6 : LCR := LCR or $01;
  142.     7 : LCR := LCR or $02;
  143.     8 : LCR := LCR or $03;
  144.   else
  145.     LCR := LCR or $03;
  146.   end;
  147.   if StopBits = 2 then
  148.     LCR := LCR or $04
  149.   else
  150.     LCR := LCR or $00;
  151.   LCR := LCR and $7F;
  152.   InLine($FA);
  153.   Port[UART.LCR+AsyncV[Handle ].Base] :=
  154.       Port[UART.LCR+AsyncV[Handle ].Base] or $80;
  155.   Port[AsyncV[Handle ].Base] := Lo(DV);
  156.   Port[AsyncV[Handle ].Base+1] := Hi(DV);
  157.   Port[UART.LCR+AsyncV[Handle ].Base] := LCR;
  158.   Inline($FB);
  159. end;
  160.  
  161. procedure AsyncIsr1;
  162. interrupt;
  163. begin
  164.   if AsyncV[1].BufferHead-AsyncV[1].BufferTail < 4095 then
  165.   begin
  166.     Inc(AsyncV[1].BufferHead);
  167.     AsyncV[1].Buffer^[AsyncV[1].BufferHead mod 4096] :=
  168.         Chr(Port[UART.RBR+AsyncV[1].Base]);
  169.     Port[$20] := $20;
  170.   end else
  171.   begin
  172.     AsyncV[1].BufferOverflow := true;
  173.     AsyncV[1].AsyncChar := Chr(Port[UART.RBR+AsyncV[1].Base]);
  174.     Port[$20] := $20;
  175.   end;
  176. end;
  177.  
  178. procedure AsyncIsr2;
  179. begin
  180.   if AsyncV[2].BufferHead-AsyncV[2].BufferTail < 4095 then
  181.   begin
  182.     Inc(AsyncV[2].BufferHead);
  183.     AsyncV[2].Buffer^[AsyncV[2].BufferHead mod 4096] :=
  184.         Chr(Port[UART.RBR+AsyncV[2].Base]);
  185.     Port[$20] := $20;
  186.   end else
  187.   begin
  188.     AsyncV[2].BufferOverflow := true;
  189.     AsyncV[2].AsyncChar := Chr(Port[UART.RBR+AsyncV[2].Base]);
  190.     Port[$20] := $20;
  191.   end;
  192. end;
  193.  
  194. function AsyncBufferRead(Handle  : byte;
  195.                          var C   : char) : boolean;
  196. begin
  197.   if AsyncV[Handle ].BufferHead < AsyncV[Handle ].BufferTail then
  198.     AsyncBufferRead := false
  199.   else
  200.   begin
  201.     C := AsyncV[Handle ].Buffer^[AsyncV[Handle ].BufferTail];
  202.     Inc(AsyncV[Handle ].BufferTail);
  203.     if AsyncV[Handle ].BufferTail = 4096then
  204.     begin
  205.       Dec(AsyncV[Handle ].BufferTail,4096);
  206.       Dec(AsyncV[Handle ].BufferHead,4096);
  207.     end;
  208.     AsyncBufferRead := true;
  209.   end;
  210. end;
  211.  
  212. procedure AsyncClose(Handle  : byte);
  213. var
  214.   I,M : integer;
  215. begin
  216.   if AsyncV[Handle ].OpenFlag then
  217.   begin
  218.     InLine($FA); { CLI }
  219.     I := Port[I8088.IMR];
  220.     M := 1 shl AsyncV[Handle ].IRQ;
  221.     Port[I8088.IMR] := I or M;
  222.     Port[UART.IER+AsyncV[Handle ].Base] := 0;
  223.     Port[UART.MCR+AsyncV[Handle ].Base] := 0;
  224.     InLine($FB); { STI }
  225.     Release(AsyncV[Handle ].HeapTop);
  226.     AsyncV[Handle ].OpenFlag := false;
  227.   end;
  228. end;
  229.  
  230. function AsyncOpen(Handle        : byte;
  231.                    ComPort       : integer;
  232.                    BaudRate      : word;
  233.                    Parity        : char;
  234.                    DataBits      : integer;
  235.                    StopBits      : integer) : boolean;
  236. var
  237.   ComParm : integer;
  238.   I,M     : integer;
  239.   Ch      : char;
  240. begin
  241.   if AsyncV[Handle ].OpenFlag then
  242.     AsyncClose(Handle );
  243.   Mark(AsyncV[Handle ].HeapTop);
  244.   New(AsyncV[Handle ].Buffer);
  245.   if (ComPort = 2) and (AsyncBIOSPortTable[2] <> 0) then
  246.     AsyncV[Handle ].Port := 2
  247.   else
  248.     AsyncV[Handle ].Port := 1;
  249.   AsyncV[Handle ].Base := AsyncBIOSPortTable[AsyncV[Handle ].Port];
  250.   AsyncV[Handle ].IRQ := Hi(AsyncV[Handle ].Base)+1;
  251.   if (Port[UART.IIR+AsyncV[Handle ].Base] and $00F8) <> 0 then
  252.     AsyncOpen := false
  253.   else
  254.   begin
  255.     AsyncV[Handle ].BufferHead := 0;
  256.     AsyncV[Handle ].BufferTail := 1;
  257.     AsyncV[Handle ].BufferOverflow := false;
  258.     AsyncChange(Handle ,BaudRate,Parity,DataBits,StopBits);
  259.     if Handle  = 1 then
  260.       SetIntVec((AsyncV[Handle ].IRQ+8) and $00FF,@AsyncIsr1)
  261.     else
  262.       SetIntVec((AsyncV[Handle ].IRQ+8) and $00FF,@AsyncIsr1);
  263.     Inline($FA);  { CLI }
  264.     Port[UART.LCR+AsyncV[Handle ].Base] := Port[UART.LCR+AsyncV[Handle ].Base] and $7F;
  265.     I := Port[UART.LSR+AsyncV[Handle ].Base];
  266.     I := Port[UART.RBR+AsyncV[Handle ].Base];
  267.     I := Port[I8088.IMR];
  268.     M := (1 shl AsyncV[Handle ].IRQ) xor $00FF;
  269.     Port[I8088.IMR] := I and M;
  270.     Port[UART.IER+AsyncV[Handle ].Base] := $01;
  271.     I := Port[UART.MCR+AsyncV[Handle ].Base];
  272.     Port[UART.MCR+AsyncV[Handle ].Base] := I or $08;
  273.     Inline($FB);  { CLI }
  274.     AsyncV[Handle ].OpenFlag := true;
  275.     AsyncOpen := true;
  276.   end;
  277. end;
  278.  
  279. function AsyncBufferCheck(Handle  : byte) : boolean;
  280. begin
  281.   AsyncBufferCheck := (AsyncV[Handle ].BufferHead >= AsyncV[Handle ].BufferTail);
  282. end;
  283.  
  284. procedure AsyncSend(Handle  : byte;
  285.                     Ch      : char);
  286. var
  287.   I,M,C : integer;
  288. begin
  289.   Port[UART.MCR+AsyncV[Handle ].Base] := $0B;
  290.   C := MaxInt;
  291.   while (C <> 0) and ((Port[UART.LSR+AsyncV[Handle ].Base] and $20) = 0) do
  292.     C := C-1;
  293.   if C <> 0 then
  294.   begin
  295.     InLine($FA);
  296.     Port[UART.THR+AsyncV[Handle ].Base] := Ord(Ch);
  297.     InLine($FB);
  298.   end else
  299.     WriteLn('<<<TIMEOUT>>>');
  300. end;
  301.  
  302. procedure AsyncSendString(Handle  : byte;
  303.                           S       : string);
  304. var
  305.   I : integer;
  306. begin
  307.   for I := 1 to Length(S) do
  308.     AsyncSend(Handle ,S[I]);
  309. end;
  310.  
  311. function Carrier(Handle  : byte) : boolean;
  312. begin
  313.   if (Port[UART.MSR+AsyncV[Handle ].Base] and $80) <> 0 then
  314.     Carrier := true
  315.   else
  316.     Carrier := false;
  317. end;
  318.  
  319. procedure AsyncCloseKeepDTR(Handle  : byte);
  320. var
  321.   I,M : integer;
  322. begin
  323.   if AsyncV[Handle ].OpenFlag then
  324.   begin
  325.     InLine($FA);
  326.     I := Port[I8088.IMR];
  327.     M := 1 shl AsyncV[Handle ].IRQ;
  328.     Port[I8088.IMR] := I or M;
  329.     Port[UART.IER+AsyncV[Handle ].Base] := 0;
  330.     Port[UART.MCR+AsyncV[Handle ].Base] := 1;
  331.     InLine($FB);
  332.     AsyncV[Handle ].OpenFlag := false;
  333.   end;
  334. end;
  335.  
  336. begin
  337.   AsyncV[1].OpenFlag := false;
  338.   AsyncV[2].OpenFlag := false;
  339. end.
  340.